(in-package :iorek)

(defvar *symbol-kind-function*)
(defvar *symbol-kind-macro*)
(defvar *symbol-kind-symbol-macro*)

;;Symbols
(let ((lang (intern "lang" *root-symbol*)))
  (setf *symbol-kind-function* (intern "function" lang))
  (setf *symbol-kind-macro* (intern "macro" lang))
  (setf *symbol-kind-symbol-macro* (intern "symbol-macro" lang)))

(defstruct environment-entry symbol value kind type)

(defstruct (environment (:constructor %make-environment)) map parent)

(defvar *top-level-environment* (%make-environment :map (fset:map)))

(defun make-environment (&optional (parent *top-level-environment*))
  (%make-environment :map (fset:map) :parent parent))

(define-condition unbound-symbol (error)
  ((symbol :initarg :symbol :reader unbound-symbol)
   (environment :initarg :environment :reader unbound-symbol-environment))
  (:report (lambda (condition stream)
	     (format stream "The symbol ~A is unbound." (with-output-to-string (s)
							  (print-object (unbound-symbol condition) s))))))

(defun iorek:symbol-value (symbol &optional (environment *top-level-environment*))
  (let ((entry (lookup (environment-map environment) symbol)))
    (if entry
        (values
         (environment-entry-value entry)
         entry
         environment)
        (if (environment-parent environment)
            (iorek:symbol-value symbol (environment-parent environment))
            (error 'unbound-symbol :symbol symbol :environment environment)))))

;;TODO setf symbol-value

(defun symbol-function (symbol &optional (environment *top-level-environment*))
  (multiple-value-bind (value entry env)
      (symbol-value symbol environment)
    (if (member (environment-entry-kind entry)
                (list *symbol-kind-function* *symbol-kind-macro*
                      :special-operator :lisp-function :lisp-function-and-variable
                      :lexical-function)) ;;TODO
        (values value entry env)
        (if (environment-parent env)
            (symbol-function symbol (environment-parent env))
            (error 'unbound-symbol :symbol symbol :environment environment)))))

(defun record-definition (symbol value &key (environment *top-level-environment*)
                          type kind)
  (setf (environment-map environment)
        (with (environment-map environment)
              symbol
              (make-environment-entry :symbol symbol :value value :type type :kind kind))))
